home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
vis082s.arc
/
CHATSTUF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-17
|
57KB
|
2,094 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
unit chatstuf; (* Chat Mode and F2 Keys *)
interface
uses crt,dos,
gentypes,gensubs,subs1,userret,flags,mainr1,modem,windows,statret,
configrt,ExecSwap,FastTTT5,WinTTT5,MenuTTT5,PullTTT5;
function specialcommand:boolean;
procedure specialseries;
procedure chat (gotospecial,color:boolean);
Procedure BustChat;
implementation
procedure write1 (l:lstr);
begin
gotoxy (25,5);
textcolor (12);
textbackground (0);
write (usr,l);
end;
function getstring (t:anystr):anystr;
var mm,lz:anystr;
begin
textbackground (0);
textcolor (12);
write (usr,t);
readline (mm);
getstring:=mm;
end;
function specialcommand:boolean;
Const Right=#205; (* Constants used to define the arrow keys *)
Left=#203;
Up=#200;
Down=#208;
NormFore=15; (* Color Constants *)
NormBack=1;
HighFore=1;
HighBack=7;
SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS'); (* Full Mem
Swaps *)
Var C:Char;
Quit:Boolean;
Major,Minor,Mainx,Mainy:Integer;
Main_Choice,Choice,Error:integer;
ScanTop, ScanBot:byte;
M1,MM:Menu_record;
Ch:char;
X,Y:Byte;
Done:Boolean;
Function ReadStri:Mstr;
Var MM:Mstr;
Begin
ReadLine(MM);
ReadStri:=MM;
End;
Procedure SendMsg(M:Lstr);
Begin
(* ClearBreak;
GotoXy(MainX,MainY);
ClrEol;
WriteLn(M); *)
End;
Procedure SplitEm;
Var Cnt:Integer;
Begin
If SplitMode then Unsplit;
GotoXy(1,15);
TextColor(9);
For Cnt:=1 to 80 Do Write(Usr,'─');
End;
Procedure ClearTop(Where:Byte);
Var Cnt:Integer;
Begin
FillScreen(1,1,80,Where,blue,blue,chr(176)); Main_Choice:=1;
TextColor(8);
Textbackground(1);
For CNT:=1 to 80 Do Begin
Gotoxy(cnt,Where+1);
Write(usr,'▄');
End;
TextColor(15);
End;
Procedure DrawABox(Count:Integer; Msg:Lstr);
Var Cnt:Integer;
Begin
TextColor(9);
TextBackground(NormBack);
GotoXy(1,1);
Write(Usr,'╒');
For Cnt:=1 to 78 Do Write(Usr,'═');
Write(Usr,'╕');
For Cnt:=1 to Count Do
Begin
GotoXy(1,1+Cnt);
Write(Usr,'│');
GotoXy(80,1+Cnt);
Write(Usr,'│');
End;
GotoXy(1,Count+2);
Write(Usr,'╘');
For Cnt:=1 to (38-(Length(Msg) div 2)) Do
Write(Usr,'═');
Textcolor(12);
Write(Usr,'[ '+Msg+' ]');
TextColor(9);
While WhereX<80 Do Write(Usr,'═');
Write(Usr,'╛');
TextBackground(0);
End;
Procedure WriteXy(A,B:Integer; M:String);
Begin
GotoXy(A,B);
Write(Usr,M);
End;
Procedure DoUserEditing;
Var T:Mstr;
Tx:Integer;
LastMinor,Cnet:Integer;
Procedure DoTop;
Var Cnt:Integer;
Begin
ClearTop(20);
DrawABox(17,'ViSiON v0.82 Online User Editing');
Minor:=1;
End;
Procedure ClearBytes(Byt:Integer);
Var X,Y,Cnt:Integer;
Begin
X:=WhereX;
Y:=WhereY;
For Cnt:=1 to Byt Do Write(Usr,' ');
GotoXy(X,Y);
End;
Procedure DrawThem;
Procedure yel;
Begin
Textcolor(14);
End;
Begin
TextBackGround(NormBack);
TextColor(NormFore);
WriteXy(33,2,'Editing User #'+Strr(Unum)+' ');
Case LastMinor of
1:Begin
WriteXy(3,3,' Handle ');yel;
WriteXy(16,3,urec.handle+' ');
End;
2:Begin
WriteXy(3,4,' Name ');yel;
WriteXy(16,4,Urec.RealName+' ');
End;
3:Begin
WriteXy(3,5,' Level ');yel;
WriteXy(16,5,Strr(Urec.Level)+' ');
End;
4:Begin
WriteXy(3,6,' G-F Lvl ');yel;
WriteXy(16,6,Strr(Urec.Glevel)+' ');
End;
5:Begin
WriteXy(3,7,' G-F Pts ');yel;
WriteXy(16,7,strr(Urec.Gpoints)+' ');
End;
6:Begin
WriteXy(3,8,' File Lvl ');yel;
WriteXy(16,8,Strr(Urec.UDLevel)+' ');
End;
7:Begin
WriteXy(3,9,' File Pts ');yel;
WriteXy(16,9,strr(Urec.UDPoints)+' ');
End;
8:Begin
WriteXy(3,10,' Password ');yel;
WriteXy(16,10,Urec.PassWord+' ');
End;
9:Begin
WriteXy(3,11,' Phone Num ');yel;
WriteXy(16,11,Urec.PhoneNum+' ');
End;
10:Begin
WriteXy(3,12,' Daily Time ');yel;
WriteXy(16,12,strr(Urec.TimeLimits)+' ');
End;
11:Begin
WriteXy(3,13,' User Note ');yel;
WriteXy(16,13,Urec.UserNote+' ');
End;
12:Begin
WriteXy(3,14,' Macro 1 ');yel;
WriteXy(16,14,Urec.Macro1+' ');
End;
13:Begin
WriteXy(3,15,' Macro 2 ');yel;
WriteXy(16,15,Urec.Macro2+' ');
End;
14:Begin
WriteXy(3,16,' Macro 3 ');yel;
WriteXy(16,16,urec.macro3+' ');
End;
15:Begin
WriteXy(3,17,' Sysop Note ');yel;
WriteXy(16,17,Urec.SpecialSysopNote+' ');
End;
16:Begin
WriteXy(57,3,' UD K Ratio ');yel;
WriteXy(70,3,strr(Urec.UDKRatio)+' ');
End;
17:Begin
WriteXy(57,4,' PCR ');yel;
WriteXy(70,4,strr(Urec.PCRatio)+' ');
End;
18:WriteXy(57,5,' Time Left ');
19:Begin
WriteXy(57,6,' U/D Ratio ');yel;
WriteXy(70,6,Strr(Urec.UDRatio)+' ');
End;
20:Begin
WriteXy(57,7,' Posts ');yel;
WriteXy(70,7,Strr(Urec.Nbu)+' ');
End;
21:Begin
WriteXy(57,8,' Uploads ');yel;
WriteXy(70,8,Strr(Urec.Uploads)+' ');
End;
22:Begin
WriteXy(57,9,' Downloads ');yel;
WriteXy(70,9,Strr(Urec.Downloads)+' ');
End;
23:Begin
WriteXy(57,10,' U/L KB ');yel;
WriteXy(70,10,Strr(Urec.UpKay)+'k');
End;
24:Begin
WriteXy(57,11,' D/L KB ');yel;
WriteXy(70,11,Strr(Urec.Dnkay)+'k');
End;
25:Begin
WriteXy(57,12,' Calls ');yel;
WriteXy(70,12,Strr(Urec.NumOn));
End;
26:Begin
WriteXy(57,13,' Exp Date ');yel;
If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A ')
Else
WriteXy(70,13,DateStr(Urec.ExpDate));
End;
27:Begin
WriteXy(57,14,' Wanted Flag ');yel;
WriteXy(70,14,YesNo(Wanted in Urec.Config)+' ');
End;
28:Begin
WriteXy(57,15,' Time bank ');yel;
WriteXy(70,15,Strr(Urec.TimeBank)+' ');
End;
29:Begin
WriteXy(57,16,' GFile Uls ');yel;
WriteXy(70,16,Strr(Urec.Nup)+' ');
End;
30:Begin
WriteXy(57,17,' GFile Dls ');yel;
WriteXy(70,17,Strr(Urec.Ndn)+' ');
End;
End; (* End Case *)
TextBackGround(HighBack);
TextColor(HighFore);
Case Minor of
1:WriteXy(3,3,' Handle ');
2:WriteXy(3,4,' Name ');
3:WriteXy(3,5,' Level ');
4:WriteXy(3,6,' G-F Lvl ');
5:WriteXy(3,7,' G-F Pts ');
6:WriteXy(3,8,' File Lvl ');
7:WriteXy(3,9,' File Pts ');
8:WriteXy(3,10,' Password ');
9:WriteXy(3,11,' Phone Num ');
10:WriteXy(3,12,' Daily Time ');
11:WriteXy(3,13,' User Note ');
12:Writexy(3,14,' Macro 1 ');
13:writexy(3,15,' Macro 2 ');
14:writexy(3,16,' Macro 3 ');
15:writexy(3,17,' SysOp Note ');
16:WriteXy(57,3,' UD K Ratio ');
17:WriteXy(57,4,' PCR ');
18:WriteXy(57,5,' Time Left ');
19:WriteXy(57,6,' U/D Ratio ');
20:WriteXy(57,7,' Posts ');
21:WriteXy(57,8,' Uploads ');
22:WriteXy(57,9,' Downloads ');
23:WriteXy(57,10,' U/L KB ');
24:WriteXy(57,11,' D/L KB ');
25:WriteXy(57,12,' Calls ');
26:WriteXy(57,13,' Exp Date ');
27:WriteXy(57,14,' Wanted Flag ');
28:Writexy(57,15,' Time Bank');
29:Writexy(57,16,' GFile ULs');
30:writexy(57,17,' GFile DLs');
End;
LastMinor:=Minor;
TextBackground(NormBack);
TextColor(NormFore);
End;
Procedure Goty(X,Y,B:Integer);
Begin
GotoXy(X,Y);
ClearBytes(b);
End;
Begin
DoTop;
LastMinor :=1;
For Cnet:=1 to 30 Do
Begin
Minor:=Cnet;
Drawthem;
End;
Minor:=1;
DrawThem;
Repeat
C:=BiosKey;
Case C Of
Up:Dec(Minor);
Down:Inc(Minor);
Right,Left:If Minor<16 then Minor:=Minor+15 Else Minor:=Minor-15;
#13:Begin
If Minor<16 Then Goty(16,Minor+2,35)
Else
Goty(70,Minor+2-15,5);
OnCursor;
Case Minor Of
1:Begin
T:=ReadStri;
If T<>'' then Urec.Handle:=T;
SendMsg('Your Handle has been changed to '+Urec.Handle);
End;
2:Begin
T:=ReadStri;
If T<>'' then Urec.RealName:=T;
SendMsg('Your Real Name has been Changed to '+Urec.RealName);
End;
3:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Level:=Tx;
Ulvl:=Tx;
SendMsg('You have been granted '+Strr(Urec.Level)+' Access.');
End;
4:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Glevel:=Tx;
SendMsg('Your G-File Level has been changed to '+Strr(Urec.Glevel));
End;
5:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Gpoints:=Tx;
SendMsg('You have been given '+Strr(Urec.Gpoints)+' G-File Points');
End;
6:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Udlevel:=Tx;
SendMsg('Your Upload/Download Level has been set to '+Strr(Urec.UdLevel));
End;
7:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.UdPoints:=Tx;
SendMsg('You now have '+strr(Urec.UdPoints)+' file points.');
End;
8:Begin
T:=ReadStri;
If T<>'' then Urec.Password:=T;
SendMsg('Your password has been changed to '+Urec.Password);
End;
9:Begin
T:=ReadStri;
If T<>'' then Urec.PhoneNum:=T;
SendMsg('Your Phone Number has been changed to '+Urec.PhoneNum);
End;
10:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.TimeLimits:=Tx;
SendMsg('Your daily time limit has been set to '+Strr(Urec.TimeLimits));
End;
11:Begin
T:=ReadStri;
If T<>'' then
Urec.UserNote:=T;
SendMsg('Your Account Note has been Changed to '+Urec.UserNote);
End;
12:Begin
T:=ReadStri;
If T<>'' then Urec.Macro1:=T;
SendMsg('Your macro #1 has been changed to '+T);
End;
13:Begin
t:=readstri;
if t<>'' then Urec.Macro2:=T;
SendMsg('Your Macro #2 has been changed to '+T);
End;
14:Begin
t:=ReadStri;
If T<>'' then Urec.Macro2:=T;
SendMsg('Your Macro #3 has been changed to '+T);
End;
15:Begin
T:=ReadStri;
If T<>'' then Urec.SpecialSysopNote:=T;
End;
19:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.UDRatio:=Tx;
SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
End;
16:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.UDKRatio:=Tx;
SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
End;
17:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.PCRatio:=Tx;
SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
End;
18:Begin
T:=ReadStri;
GotY(70,5,5);
SetTimeLeft(Valu(T));
bottomline;
SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
End;
20:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Nbu:=Tx;
SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
End;
21:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Uploads:=Tx;
SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
End;
22:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Downloads:=Tx;
SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
End;
23:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.UpKay:=Tx;
SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
End;
24:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.DnKay:=Tx;
SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
End;
25:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.NumOn:=Tx;
SendMsg('Your total calls have been set to '+Strr(Tx));
End;
26:Begin
T:=ReadStri;
If T<>'' then Begin
Urec.ExpDate:=DateVal(T);
SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
End;
End;
27:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
Urec.Config:=Urec.Config+[Wanted];
28:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.TimeBank:=Tx;
SendMsg('Your time in your time bank has been set to '+Strr(Tx));
End;
29:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Nup:=Tx;
SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
End;
30:Begin
T:=ReadStri;
Tx:=Valu(T);
Urec.Ndn:=Tx;
SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
End;
End;
OffCursor;
End;
End;
If Minor=31 then Minor:=1;
If Minor=0 then Minor:=30;
DrawThem;
Until C=#27;
TextBackGround(0);
FillScreen(1,1,80,24,white,blue,chr(176));
Main_Choice:=1;
End;
Procedure DoAccessFlags;
Var Quit:Boolean;
Procedure DrawTop;
Var Cnt:Integer;
Begin
DrawABox(4,'Access Flag Editing Commands');
Minor:=1;
End;
Procedure GetMainConferences;
Procedure DrawT;
Var Cnt:Integer;
Begin
DrawABox(5,'Access to Main Conferences');
Minor:=1;
End;
Procedure Choices;
Var CountMe:Integer;
Begin
TextBackground(NormBack);
TextColor(NormFore);
for countme:=1 to 5 do
Begin
GotoXy(31,1+CountMe);
Write(Usr,' Conference ',countme,' - ');
if Urec.Conf[CountMe] then Write(Usr,'Yes ') else
Write(Usr,'No ');
End;
GotoXy(31,1+Minor);
TextColor(HighFore);
TextBackground(HighBack);
Write(Usr,' Conference ',Minor,' - ');
If Urec.Conf[Minor] then Write(Usr,'Yes ') else Write(Usr,'No ');
TextColor(NormFore);
TextBackground(NormBack);
End;
Begin
ClearTop(7);
DrawT;
Repeat
Choices;
C:=BiosKey;
Case C Of
Left,Up:Dec(Minor);
Down,Right:Inc(Minor);
#13:Begin
Urec.Conf[Minor]:=Not Urec.Conf[Minor];
If Urec.Conf[Minor] then SendMsg('You have been granted access to main conference #'+Strr(Minor))
Else SendMsg('You have been denied access to Main Conference #'+Strr(Minor));
End;
End;
If Minor>5 then Minor:=1;
If Minor<1 then Minor:=5;
Until C=#27;
FillScreen(1,1,80,24,white,blue,chr(176));
Main_Choice:=1;
End;
Procedure GetSubConferences;
Var T:Mstr;
Tx:Integer;
Procedure ShowSubs;
Var Cnt:Integer;
Begin
ClearTop(7);
GotoXy(1,1);
WriteLn(Usr,' Sub Conference Access Flags');
Write(Usr,^M^J);
Write(Usr,' ');
For Cnt:=1 to 18 do
If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
Write(Usr,'0,');
Write(Usr,^M^J);
Write(Usr,' ');
For Cnt:=19 to 31 Do
If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
Write(Usr,'0,');
If Urec.ConfSet[32]>0 then WriteLn(Usr,'32') else writeLn(Usr,'0');
End;
Begin
Repeat
ShowSubs;
Write(Usr,^M^J);
Write(Usr,'Enter conference to change, or [Return] to exit:');
T:=ReadStri;
If T<>'' then Begin
Tx:=Valu(T);
If (Tx>0) and (TX<33) then
If Urec.ConfSet[Tx]=0 then Urec.Confset[Tx]:=1 Else
Urec.Confset[Tx]:=0;
End;
Until T='';
FillScreen(1,1,80,24,white,blue,chr(176));
Main_Choice:=1;
End;
procedure getnewaccess;
var q,bname:sstr;
bn:integer;
ac:accesstype;
wasopen:boolean;
k:char;
function inputaccess (q:sstr):accesstype;
begin
inputaccess:=invalid;
if length(q)=0 then exit;
case upcase(q[1]) of
'L':inputaccess:=letin;
'B':inputaccess:=bylevel;
'K':inputaccess:=keepout
end
end;
procedure getallaccess;
procedure setallaccess (ac:accesstype);
var cnt:integer;
begin
setalluserflags (urec,ac);
SendMsg ('Your access to all sub-boards: '+accessstr[ac]);
writeurec
end;
begin
Write (Usr,'ALL acc. ([B]y level, [L]et in, [K]eep out, or CR): ');
Q:=ReadStri;
ac:=inputaccess(q);
if ac<>invalid then setallaccess(ac)
end;
var bd:boardrec;
begin
ClearTop(7);
GotoXy(25,1);
WriteLn(Usr,'Change Sub-Board Access');
GotoXy(1,3);
Write(Usr,'Which Sub-Board to change access for [''*''/ALL]: ');
Bname:=ReadStri;
if length(bname)<1 then Begin FillScreen(1,1,80,24,white,blue,chr(176)); exit; End;
if bname='*' then
begin
getallaccess;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
exit
end;
opentempbdfile;
bn:=searchboard(bname);
if bn=-1 then
begin
closetempbdfile;
Write(Usr,'No such board! Press any key..');
k:=bioskey;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
exit
end;
writeln (Usr,'Board '+bname+'... Current access: '+accessstr[getuseraccflag(urec,bn)]);
Write(Usr,'Access ([B]y level, [L]et in, [K]eep out, or [CR]: ');
q:=readstri;
ac:=inputaccess(q);
if ac=invalid then begin
closetempbdfile;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
exit
end;
setuseraccflag (urec,bn,ac);
writeurec;
closetempbdfile;
SendMsg ('New access for sub-board '+bname+': '+accessstr[ac]);
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
end;
procedure getsysopaccess;
const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
sectionnames:array [udsysop..databasesysop] of string[20]=
('File transfer','Bulletin section','Voting booths',
'E-mail section','Doors','Main menu','Databases');
var cnt:configtype;
x:string[10];
n,mx:integer;
v:boolean;
begin
repeat
ClearTop(10);
GotoXy(1,1);
mx:=1;
for cnt:=udsysop to databasesysop do begin
write (usr,mx:3,'. ',sectionnames[cnt]);
mx:=mx+1;
gotoxy (25,wherey);
writeln (usr,sysopstr[cnt in urec.config])
end;
write (usr,^M^J'Number to toggle [CR to exit]: ');
readline (x);
n:=valu(x);
v:=(n>0) and (n<mx);
if v then begin
cnt:=configtype(ord(udsysop)+n-1);
if cnt in urec.config
then
begin
urec.config:=urec.config-[cnt];
x:='denied'
end
else
begin
urec.config:=urec.config+[cnt];
x:='granted'
end;
SendMsg ('You have been '+x+' sysop priveleges for the '+
sectionnames[cnt]+'.')
end
until not v;
writeurec;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
end;
Procedure Which_Flag;
begin
Menu_Set(M1);
With M1 do
begin
Heading1 := '';
Heading2 := 'Confernce/Flag/Access Editing';
Topic[1] := ' Main Conference [1-5]';
Topic[2] := ' Access Flags [1-30]';
Topic[3] := ' Sub-Board Access (Msgs) ';
Topic[4] := ' SysOp Access Flags';
Topic[5] := ' Quit To Main SysOp Menu ';
TotalPicks := 5;
PicksPerLine := 1; {one column of choices}
Addprefix := 1; {add function key prefixes}
TopleftXY[1] := 5; {system will center menu}
TopleftXY[2] := 6; {Y coordinate}
Boxtype := 5; {fancy box}
If ColorScreen then
begin
Colors[1] := white; {hi forground}
Colors[2] := magenta; {hi background}
Colors[3] := lightgray; {lo foreground}
Colors[4] := red; {lo background}
Colors[5] := lightgray; {box color}
end
else
begin
Colors[1] := white; {hi forground}
Colors[2] := black; {hi background}
Colors[3] := black; {lo foreground}
Colors[4] := lightgray; {lo background}
Colors[5] := white; {box color}
end;
AllowEsc := false; {inactivate the escape key}
Margins := 5;
end; {with M1 do}
end; {Define_Menu1}
Begin
Quit:=False;
Findcursor(X,Y,ScanTop,ScanBot);
Main_Choice := 1;
Done:=False;
Buflen:=40;
repeat
Which_Flag;
DisplayMenu(M1,false,Main_Choice,Error);
Case Main_Choice of
1:GetMainConferences;
2:GetSubConferences;
3:GetNewAccess;
4:GetSysOpAccess;
5:Quit:=True;
end; {case}
until Quit;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
End;
Procedure Which_Other;
begin
Menu_Set(M1);
With M1 do
begin
Heading1 := '';
Heading2 := 'Other SysOp Commands';
Topic[1] := ' Hang Up On User';
Topic[2] := ' Delete User (Nuke)';
Topic[3] := ' Snoop Mode [ON]';
Topic[4] := ' Snoop Mode [OFF]';
Topic[5] := ' Quit To Main SysOp Menu ';
TotalPicks := 5;
PicksPerLine := 1; {one column of choices}
Addprefix := 1; {add function key prefixes}
TopleftXY[1] := 28; {system will center menu}
TopleftXY[2] := 13; {Y coordinate}
Boxtype := 5; {fancy box}
If ColorScreen then
begin
Colors[1] := white; {hi forground}
Colors[2] := magenta; {hi background}
Colors[3] := lightgray; {lo foreground}
Colors[4] := red; {lo background}
Colors[5] := lightgray; {box color}
end
else
begin
Colors[1] := white; {hi forground}
Colors[2] := black; {hi background}
Colors[3] := black; {lo foreground}
Colors[4] := lightgray; {lo background}
Colors[5] := white; {box color}
end;
AllowEsc := false; {inactivate the escape key}
Margins := 5;
end; {with M1 do}
end; {Define_Menu1}
Procedure DoOther;
Var Quit:Boolean;
Begin
Quit:=False;
Findcursor(X,Y,ScanTop,ScanBot);
Main_Choice := 1;
Done:=False;
Buflen:=40;
repeat
Which_Other;
DisplayMenu(M1,false,Main_Choice,Error);
Case Main_Choice of
1:Begin
gotoxy(1,25);
Write('Sorry but the BBS is going down right now!');
ForceHangup:=True;
HangUp;
End;
2:Begin
Urec.Level:=-1;
gotoxy(1,25);
Write('You''re Nuked BUDDY!');
ForceHangup:=True;
HangUp;
End;
3:Begin
ModemInlock:=True;
SetOutLock(True);
gotoxy(1,25);
Sound(500);
NoSound;
End;
4:Begin
gotoxy(1,25);
Sound(250);
NoSound;
ModemInlock:=False;
SetOutLock(False);
End;
5:Quit:=True;
end; {case}
until Quit;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
End;
procedure gotodos (i:integer);
var status:word;
tmp1:integer;
st:mstr;
begin
gotoxy(1,25);
Write ('■ Sysop in DOS ■');
ansicolor(15);
window (1,1,80,25);
gotoxy (1,25);
writeln (usr,^M^J^J^J);
updateuserstats (false);
if i=1 then begin
textbackground(0);
clrscr; textcolor(15);
writeln(usr,'«« ViSiON Dos Shell »»');
writeln(usr,'Type ''EXIT'' to return.'^M);
tmp1:=timeleft;
if not configset.maximumdosshell then begin
swapvectors;
exec(getenv('COMSPEC'),'');
swapvectors;
End Else Begin
WriteLn(Usr,'Allocated ',bytesswapped,' bytes ',swaploc[EmsAllocated]);
SwapVectors;
Status:=ExecWithSwap(GetEnv('Comspec'),'');
SwapVectors;
End;
st:=configset.forumdi;
if st[length(st)]='\' then st[length(st)]:=#0;
chdir(st);
settimeleft(tmp1);
bottomline;
end else if i=2 then begin
ensureclosed;
writereturnbat;
closeport;
halt (4);
end;
Textbackground(0);
ClrScr;
FillScreen(1,1,80,24,white,blue,chr(176));
end;
procedure runconfig;
var status:word;
begin
if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
swapvectors;
exec(getenv('COMSPEC'), '/C CONFIG.EXE');
swapvectors;
readconfig;
FillScreen(1,1,80,24,white,blue,chr(176));
end;
procedure dotexteditor;
begin
if length(configset.edito)<1 then exit;
window (1,1,80,25);
gotoxy (1,25);
writeln (usr,^M^J^J^J); updateuserstats (false);
exec(GetEnv('COMSPEC'), '/C '+configset.edito);
FillScreen(1,1,80,24,white,blue,chr(176));
end;
Procedure Which_SysOp;
begin
Menu_Set(M1);
With M1 do
begin
Heading1 := 'ViSiON v0.82 By: Crimson Blade';
Heading2 := 'Online SysOp Commands';
Topic[1] := ' ViSiON SysOp User Editor ';
Topic[2] := ' Set User Access Flags';
Topic[3] := ' Other Commands';
Topic[4] := ' Shell To DOS';
Topic[5] := ' Full Drop To DOS';
Topic[6] := ' Run Configuration Program ';
Topic[7] := ' Run Text Editor';
Topic[8] := ' Chat Commands';
Topic[9] := ' Quit SysOp Commands';
TotalPicks := 9;
PicksPerLine := 1; {one column of choices}
Addprefix := 1; {add function key prefixes}
TopleftXY[1] := 0; {system will center menu}
TopleftXY[2] := 4; {Y coordinate}
Boxtype := 5; {fancy box}
If ColorScreen then
begin
Colors[1] := white; {hi forground}
Colors[2] := magenta; {hi background}
Colors[3] := lightgray; {lo foreground}
Colors[4] := blue; {lo background}
Colors[5] := lightgray; {box color}
end
else
begin
Colors[1] := white; {hi forground}
Colors[2] := black; {hi background}
Colors[3] := black; {lo foreground}
Colors[4] := lightgray; {lo background}
Colors[5] := white; {box color}
end;
AllowEsc := false; {inactivate the escape key}
Margins := 5;
end; {with M1 do}
end; {Define_Menu1}
Begin
WriteLn(^R'■ '^A'One Moment'^R' ■');
SplitScreen(25);
Activate_Visible_Screen;
textbackground(0);
Clrscr;
FillScreen(1,1,80,24,white,blue,chr(176));
Findcursor(X,Y,ScanTop,ScanBot);
OffCursor;
Main_Choice := 1;
Done:=False;
Buflen:=40;
Textbackground(0);
repeat
Which_SysOp;
DisplayMenu(M1,false,Main_Choice,Error);
Case Main_Choice of
1:Begin ClrScr; DoUserEditing; End;
2:Begin DoAccessFlags; End;
3:Begin DoOther; End;
4:Begin ClrScr; Gotodos(1); End;
5:Begin ClrScr; Gotodos(2); End;
6:Begin ClrScr; RunConfig; End;
7:Begin ClrScr; DoTextEditor; End;
8:Begin Done:=True; BustChat; Done:=True; End;
9:Done:=True;
end; {case}
until Done;
OnCursor;
ClrScr;
UnSplit;
Main_Choice:=1;
End;
procedure specialseries;
begin
repeat until specialcommand
end;
procedure chat (gotospecial,color:boolean);
var k:char;
StartedTime:Word;
cnt,displaywid:integer;
quit,carrierloss,fromkbd:boolean;
baudstr,commstr:mstr;
c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;
xsys :byte;
ysys :byte;
xusr :byte;
yusr :byte;
curcolor :byte;
ec :byte;
initi :boolean;
linebufs :string[80];
linebufu :string[80];
procedure init;
begin
xsys :=1;
ysys :=14;
xusr :=1;
yusr :=4;
curcolor :=1;
ec :=1;
initi :=true;
linebufs :='';
linebufu :='';
inuse:=2;
end;
procedure sendxy (x,y:byte);
begin
write(#27+'[',y,';',x,'H');
end;
Procedure clearscre;
var i:byte;
begin
for I:=4 to 23 do
begin
sendxy(1,i);
write(#27'[K');
end;
end;
Procedure setc;
begin
if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
if curcolor<>ec then begin
curcolor:=ec;
end;
end;
procedure midline;
begin
sendxy(1,13);
write(^R'───────────────────────────'^S' '^P'ViSiON '+versionnum+' - '+timestr(now)+^R);
write(' ───────────────────────────');
sendxy(trunc((21-length(configset.sysopnam))/2),13);
write (^R'─ '^S+configset.sysopnam+^R' ─');
sendxy(trunc((24-length(urec.handle))/2)+52,13);
write (^R'─ '^S+urec.handle+^R' ─');
end;
Procedure cle (malig:byte);
var i :byte;
begin
if malig=0 then
begin
for i:=14 to 23 do
begin
sendxy(1,i);
ansicolor(1);
write(#27'[K');
end;
sendxy(1,14);
malig:=0;
end;
if malig=1 then
begin
for i:=4 to 12 do
begin
sendxy(1,i);
ansicolor(1);
write(#27,'[K');
end;
sendxy(1,4);
malig:=0;
end;
end;
procedure wordwrapit(yeanea:byte);
var cnt :byte;
wl :integer;
ww :lstr;
cutarea :byte;
done :boolean;
begin
done:=false;
cutarea:=0;
ww:='';
cnt:=80;
if yeanea=0 then
begin
If Pos(' ',LineBufs)<=0 then Begin
Writeln;
LineBufs:='';
Xsys:=1;
Inc(Ysys);
Exit;
End;
repeat
if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
if (cutarea>0) and not done then
begin
ww:=copy(linebufs,cnt+1,255);
ansicolor(urec.statcolor);
sendxy(cutarea,ysys);
write(#27'[K');
inc(ysys);
xsys:=1;
sendxy(xsys,ysys);
write(copy(linebufs,cutarea+1,80-cutarea));
xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
sendxy(xsys,ysys);
dec(ysys);
done:=true
end;
dec(cnt);
until cnt=1;
linebufs:=ww;
end;
if yeanea=1 then
begin
If Pos(' ',LineBufu)<=0 then Begin
Writeln;
Inc(Yusr);
Xusr:=0;
LineBufu:='';
Exit;
End;
done:=false;
cutarea:=0;
ww:='';
cnt:=80;
repeat
if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
if (cutarea>0) and not done then
begin
ww:=copy(linebufu,cnt+1,255);
ansicolor(urec.inputcolor);
sendxy(cutarea,yusr);
write(#27'[K');
inc(yusr);
xusr:=1;
sendxy(xusr,yusr);
write(copy(linebufu,cutarea+1,80-cutarea));
xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1;
sendxy(xusr,yusr);
dec(yusr);
done:=true
end;
dec(cnt);
until cnt=1;
linebufu:=ww;
end;
end;
Procedure locate;
begin
if fromkbd then
begin
if (xsys=80) and (ysys<23) then
begin
wordwrapit(0);
inc(ysys);
end;
if ((ysys=23) and (xsys=80)) or (ysys>23) then
begin
cle(0);
ysys:=14;
xsys:=1;
sendxy(xsys,ysys);
ansicolor(urec.statcolor);
write(^S+linebufs);
ansireset;
sendxy(80-length(linebufs)+1,ysys);
ansireset;
wordwrapit(0);
inc(ysys);
sendxy(xsys,ysys);
end;
sendxy(xsys,ysys);
inc(xsys);
end;
if not fromkbd then
begin
if (xusr=80) and (yusr<12) then
begin
wordwrapit(1);
inc(yusr);
end;
if ((yusr=12) and (xusr=80)) or (yusr>12) then
begin
cle(1);
yusr:=4;
xusr:=1;
sendxy(xusr,yusr);
ansicolor(urec.inputcolor);
write(^U+linebufu);
ansireset;
sendxy(80-length(linebufu)+1,yusr);
ansireset;
wordwrapit(1);
inc(yusr);
sendxy(xusr,yusr);
end;
sendxy(xusr,yusr);
inc(xusr);
end;
end;
procedure instruct;
var i:integer;
begin
for i:=1 to 5 do
begin
sendxy(1,i);
write(#27,'[K');
end;
splitscreen (2);
top;
clrscr;
write (usr,'Now in Chat mode. Press [F1] to leave or [F2] for commands.');
initi:=false;
bottom;
sendxy(1,4);
end;
Procedure ChangeVars;
Begin
backup:=c1;
c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
ansicolor(c1);
End;
Procedure GetCrazyVars;
Begin
If Color Then Begin
c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
c7:=configset.kkk7; c8:=configset.kkk8;
End Else Begin
c1:=urec.inputcolor;
End;
End;
procedure typedchar (k:char);
begin
ChangeVars;
locate;
begin;
If (c1<1) and (c1>15) then getcrazyvars;
if fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.statcolor); linebufs:=linebufs+K;
end;
if not fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.inputcolor); linebufu:=linebufu+K;
end;
write(k)
end;
end;
begin
carrierloss:=false;
chatmode:=false;
writeln (^B^M);
if wanted in urec.config then begin
specialmsg ('(No longer wanted)');
urec.config:=urec.config-[wanted];
writeurec;
end;
if eightycols in urec.config then displaywid:=80 else displaywid:=40;
if gotospecial then begin
specialseries;
exit
end;
clearbreak;
nobreak:=true;
writeln (^M^M,configset.entercha,^M^R);
StartedTime:=TimeLeft;
instruct;
if not initi then
begin
CLEARSCRE;
Sendxy(1,13); ANSiCOLOR(15);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
Sendxy(1,13); ANSiCOLOR(7);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
Sendxy(1,13); ANSiCOLOR(8);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
if color then GetCrazyVars;
init;
clearscre;
midline;
end;
quit:=false;
nobreak:=true;
break:=false;
repeat
linecount:=0;
if (not carrierloss) and (not carrier) then begin
carrierloss:=true;
gotoxy(1,4);
writeln (^M'Warning: There is no carrier present.'^M)
end;
repeat until keyhit or (carrier and (numchars>0));
fromkbd:=keyhit;
ingetstr:=true;
if fromkbd then
k:=bioskey else
k:=getchar;
if k=#127 then k:=#8;
if k > #127 then if ((ord(k) - 128) in [59,60]) then begin
if (ord(k) - 128) = 60 then begin
quit:=specialcommand;
if not quit then instruct;
clearbreak;
unsplit;
end;
nobreak:=true;
writeln (^M^M,configset.exitcha,^M^R);
SetTimeLeft(StartedTime);
write (#27'[J');
bottomline;
chainstr:='';
input:='';
write (lastprompt);
exit;
end;
case ord(k) of
8:begin
if (xsys>1) and fromkbd then
begin
modeminlock:=true;
if xsys>1 then dec(xsys);
sendxy(xsys,ysys);
write (' ');
sendxy(xsys,ysys);
if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
modeminlock:=false;
end;
if (xusr>1) and not fromkbd then
begin
modeminlock:=true;
if xusr>1 then dec(xusr);
sendxy(xusr,yusr);
write (' ');
sendxy(xsys,ysys);
if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
modeminlock:=false;
end;
end;
0:;
13:begin
writeln;
bottomline;
if fromkbd then begin
xsys:=1;
inc(ysys);
if (ysys>=21) then
begin
cle(0);
ysys:=14;
xsys:=1;
sendxy(xsys,ysys);
ansicolor(urec.statcolor);
write(linebufs);
ysys:=15;
xsys:=1;
end;
sendxy(xsys,ysys);
linebufs:='';
end;
if not fromkbd then begin
xusr:=1;
inc(yusr);
if (yusr=13) then
begin
cle(1);
yusr:=4;
xusr:=1;
ansicolor(urec.inputcolor);
sendxy(xusr,yusr);
write(linebufu);
yusr:=5;
sendxy(xusr,yusr);
end;
sendxy(xusr,yusr);
linebufu:='';
end;
end;
32..255:typedchar (k);
1..31:if fromkbd and carrier then sendchar(k);
end
until quit;
clearbreak
end;
Procedure OnelineChat;
VAR k:char;
cnt,displaywid:integer;
StartedTime:Word;
quit,carrierloss,fromkbd:boolean;
linebuffer:lstr;
l:byte absolute linebuffer;
curcolor:byte;
Procedure instruct;
begin
splitscreen (3);
top;
clrscr;
write (usr,'Now in chat mode. Press <F1> to leave or <F2> for commands.');
bottom
end;
Procedure wordwrap;
VAR cnt,wl:integer;
ww:lstr;
begin
ww:='';
cnt:=displaywid;
while (cnt>0) and (linebuffer[cnt]<>' ') do cnt:=cnt-1;
if cnt=0 then ww:=k else begin
ww:=copy(linebuffer,cnt+1,255);
wl:=length(ww)-1;
if wl>0 then begin
for cnt:=1 to wl do write (^H);
for cnt:=1 to wl do write (' ')
end
end;
writeln;
ansicolor (curcolor);
write (ww);
linebuffer:=ww
end;
Procedure typedchar (k:char);
VAR ec:byte;
begin
l:=l+1;
linebuffer[l]:=k;
if l=displaywid then wordwrap else write(k)
end;
VAR Ch : CHAR;
inchat:boolean;
begin
While Keypressed DO
Ch := ReadKey;
Writeln(^M);
carrierloss := false;
chatmode := false;
InChat := TRUE;
writeln(^B);
if (wanted in urec.config) AND (Ulvl < 90) then begin
specialmsg ('(No longer wanted)');
urec.config:=urec.config-[wanted];
writeurec;
end;
if eightycols in urec.config then displaywid:=80 else displaywid:=40;
if length(chatreason)>0 then specialmsg ('(Chat reason: '+chatreason+')');
chatreason:='';
clearbreak;
nobreak := TRUE;
Writeln (^M^M^R,configset.entercha,^M^M);
StartedTime:=TimeLeft;
instruct;
quit:=false;
l:=0;
curcolor:=urec.regularcolor;
nobreak:=true;
repeat
linecount:=0;
if (not carrierloss) and (not carrier) then begin
carrierloss:=true;
writeln (^M'Warning: No Carrier detected.'^M)
end;
repeat until keyhit or (carrier and (numchars>0));
fromkbd:=keyhit;
ingetstr:=true;
curcolor:=urec.inputcolor;
if not keyhit then read(directin,k) else begin curcolor:=urec.statcolor;
K:=bioskey;
if (ord(k)>127) then if ((ord(k)-128)=chatchar) then inchat:=false;
if (ord(k)>127) then if ((ord(k)-129)=chatchar) then begin specialseries;
inchat:=false;
end;
end;
ansicolor(curcolor);
if k=#127 then k:=#8;
Quit := NOT Inchat;
if quit then k:=#0;
case ord(k) of
8:if l>0 then begin
write (k+' '+k);
l:=l-1
end;
0:;
13:begin
writeln;
bottomline;
l:=0
end;
32..255:typedchar (k);
1..31:if fromkbd and carrier then sendchar(k)
end
until quit;
chainstr:='';
input:='';
UnSplit;
ClearBreak;
Writeln(^M^M^R,configset.exitcha,^M);
SetTimeLeft(StartedTime);
bottomline;
End;
procedure regchat(color:Boolean); (* Vertical Chat *)
var k:char;
StartedTime:Word;
cnt,displaywid:integer;
quit,carrierloss,fromkbd:boolean;
baudstr,commstr:mstr;
c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;
xsys :byte;
ysys :byte;
xusr :byte;
yusr :byte;
curcolor :byte;
ec :byte;
initi :boolean;
linebufs :string[38];
linebufu :string[38];
procedure init;
begin
xsys :=1;
ysys :=5;
xusr :=42;
yusr :=5;
curcolor :=1;
ec :=1;
initi :=true;
linebufs :='';
linebufu :='';
inuse:=2;
end;
procedure sendxy (x,y:byte);
begin
write(#27+'[',y,';',x,'H');
end;
Procedure clearscre;
var i:byte;
begin
for I:=1 to 24 do
begin
sendxy(1,i);
write(#27'[K');
end;
end;
Procedure setc;
begin
if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
if curcolor<>ec then begin
curcolor:=ec;
end;
end;
procedure midline;
var i:byte;
begin
unsplit;
clearscre;
ClearScr;
sendxy(1,2);
write(^P'───────────────────────────────────────┬──────────────────────────────────────');
sendxy(trunc((21-length(configset.sysopnam))/2),1);
write (^A'■ '^S+configset.sysopnam+^A' ■');
sendxy(trunc((24-length(urec.handle))/2)+52,1);
write (^A'■ '^S+urec.handle+^A' ■');
sendxy(1,3); ansicolor(31);
Write(' ViSiON Vertical Split Screen Chat ');
sendxy(42,3); ansicolor(31);
Write(' ViSiON Vertical Split Screen Chat ');
For i:=3 to 23 Do Begin
Sendxy(40,i);
Write(^P'│');
end;
End;
Procedure cle (malig:byte);
var i,x :byte;
begin
if malig=0 then
begin
for i:=4 to 22 do
begin
sendxy(1,i);
write(' ');
end;
sendxy(1,4);
malig:=0;
end;
if malig=1 then
begin
for i:=4 to 22 do
begin
sendxy(42,i);
write(' ');
end;
sendxy(42,4);
malig:=0;
end;
end;
procedure wordwrapit(yeanea:byte);
var cnt :byte;
wl :integer;
ww :lstr;
cutarea :byte;
done :boolean;
begin
done:=false;
cutarea:=0;
ww:='';
cnt:=80;
if yeanea=0 then
begin
If Pos(' ',LineBufs)<=0 then Begin
Writeln;
LineBufs:='';
Xsys:=1;
Inc(Ysys);
Exit;
End;
repeat
if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
if (cutarea>0) and not done then
begin
ww:=copy(linebufs,cnt+1,255);
ansicolor(urec.statcolor);
sendxy(cutarea,ysys);
(* write(' '); *)
inc(ysys);
xsys:=1;
sendxy(xsys,ysys);
write(copy(linebufs,cutarea+1,80-cutarea));
xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
sendxy(xsys,ysys);
dec(ysys);
done:=true
end;
dec(cnt);
until cnt=1;
linebufs:=ww;
end;
if yeanea=1 then
begin
If Pos(' ',LineBufu)<=0 then Begin
Inc(Yusr);
Xusr:=42;
LineBufu:='';
sendxy (xusr,yusr);
Exit;
End;
done:=false;
cutarea:=0;
ww:='';
cnt:=80;
repeat
if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
if (cutarea>0) and not done then
begin
ww:=copy(linebufu,cnt+1,255);
ansicolor(urec.inputcolor);
(* sendxy(cutarea,yusr);
write(' '); *)
inc(yusr);
xusr:=42;
sendxy(xusr,yusr);
(* write(copy(linebufu,cutarea+1,80-cutarea+40)); *)
sendxy(42,yusr);
write(linebufu);
xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1; (* Added +40 *)
sendxy(xusr,yusr);
dec(yusr);
done:=true
end;
dec(cnt);
until cnt=1;
linebufu:=ww;
end;
end;
Procedure locate;
begin
if fromkbd then begin
if (xsys=39) and (ysys<22) then begin
{ wordwrapit(0); }
xsys:=1;
inc(ysys);
end;
if ((ysys=22) and (xsys=39)) or (ysys=22) then begin
cle(0);
ysys:=4;
xsys:=1;
sendxy(xsys,ysys);
write(^S+linebufs);
sendxy(80-length(linebufs)+1,ysys);
{ wordwrapit(0); }
ysys:=5;
sendxy(xsys,ysys);
end;
sendxy(xsys,ysys);
inc(xsys);
end else begin
if (xusr=77) and (yusr<22) then begin
{ wordwrapit(1); }
xusr:=42;
inc(yusr);
end;
if ((yusr=22) and (xusr=77)) or (yusr=22) then begin
cle(1);
yusr:=4;
xusr:=42;
sendxy(xusr,yusr);
ansicolor(urec.inputcolor);
write(linebufu);
sendxy(80-length(linebufu)+41,yusr);
{ wordwrapit(1); }
yusr:=5;
sendxy(xusr,yusr);
end;
sendxy(xusr,yusr);
inc(xusr);
end;
end;
procedure instruct;
var i:integer;
begin
If initi then begin
initi:=false;
sendxy(1,4);
end else
end;
Procedure ChangeVars;
Begin
backup:=c1;
c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
ansicolor(c1);
End;
Procedure GetCrazyVars;
Begin
If Color Then Begin
c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
c7:=configset.kkk7; c8:=configset.kkk8;
End Else Begin
c1:=urec.inputcolor;
End;
End;
procedure typedchar (k:char);
begin
ChangeVars;
locate;
If (c1<1) and (c1>15) then getcrazyvars;
if fromkbd then begin
If Color then ansicolor(c1) else ansicolor(urec.promptcolor);
linebufs:=linebufs+K;
end else begin
If Color then ansicolor(c1) else ansicolor(urec.inputcolor);
linebufu:=linebufu+K;
end;
write(k)
end;
begin
carrierloss:=false;
chatmode:=false;
writeln (^B^M);
if wanted in urec.config then begin
specialmsg ('(No longer wanted)');
urec.config:=urec.config-[wanted];
writeurec;
end;
if eightycols in urec.config then displaywid:=80 else displaywid:=40;
clearbreak;
nobreak:=true;
writeln (^M^M,configset.entercha,^M^R);
StartedTime:=TimeLeft;
instruct;
if not initi then
begin
CLEARSCRE;
sendXY(1,13); ANSiCOLOR(15);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
sendXy(1,13); ANSiCOLOR(7);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
sendXy(1,13); ANSiCOLOR(8);
WriteLn(' ViSiON 2/Way Chat v0.82'); Delay(100);
if color then GetCrazyVars;
init;
clearscre;
midline;
end;
quit:=false;
nobreak:=true;
break:=false;
repeat
linecount:=0;
if (not carrierloss) and (not carrier) then begin
carrierloss:=true;
(* gotoxy(1,4);
writeln (^M'Warning: There is no carrier present.'^M) *)
end;
repeat until keyhit or (carrier and (numchars>0));
fromkbd:=keyhit;
ingetstr:=true;
if fromkbd then
k:=bioskey else
k:=getchar;
if k=#127 then k:=#8;
if k > #127 then if ((ord(k) - 128) in [60,61]) then begin
if (ord(k) - 128) = 60 then begin
quit:=specialcommand;
if not quit then instruct;
clearbreak;
unsplit;
end;
nobreak:=true;
writeln (^M^M,configset.exitcha,^M^R);
SetTimeLeft(StartedTime);
write (#27'[J');
bottomline;
chainstr:='';
input:='';
write (#13);
exit;
end;
case ord(k) of
8:begin
if (xsys>1) and fromkbd then
begin
modeminlock:=true;
if xsys>1 then dec(xsys);
sendxy(xsys,ysys);
write (' ');
sendxy(xsys,ysys);
if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
modeminlock:=false;
end;
if (xusr>42) and not fromkbd then
begin
modeminlock:=true;
if xusr>42 then dec(xusr);
sendxy(xusr,yusr);
write (' ');
sendxy(xsys,ysys);
if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
modeminlock:=false;
end;
end;
0:;
13:begin
bottomline;
if fromkbd then begin
xsys:=1;
inc(ysys);
if (ysys>=22) then begin
cle(0);
ysys:=4;
xsys:=1;
sendxy(xsys,ysys);
ansicolor(urec.statcolor);
write(linebufs);
ysys:=5;
end;
sendxy (xsys,ysys);
linebufs:='';
end else begin
xusr:=42;
inc(yusr);
if (yusr>=22) then begin
cle(1);
yusr:=5;
xusr:=42;
ansicolor(urec.inputcolor);
sendxy(xusr - 1,yusr);
write(linebufu);
sendxy(xusr,yusr);
end;
sendxy(xusr,yusr);
linebufu:='';
end;
end;
32:If not fromkbd then Begin linebufu:=''; typedchar (k) end
else typedchar(k);
33..255:typedchar (k);
1..31:if fromkbd and carrier then sendchar(k);
end
until quit;
chainstr:='';
input:='';
clearbreak
end;
Procedure BustChat; (* Pulldown Menus For ViSiON; Use'n Techo-Jock's ToolKit *)
Var Main_Choice,Choice,Error:integer;
ScanTop, ScanBot:byte;
M1,MM:Menu_record;
Ch:char;
X,Y:Byte;
Done:Boolean;
Procedure Which_Chat;
begin
Menu_Set(M1);
With M1 do
begin
Heading1 := 'ViSiON v0.82 Online SysOp Chat Commands';
Heading2 := 'Chat Commands';
Topic[1] := ' Regular Color - Split Screen';
Topic[2] := ' Multi-Colored - Split Screen';
Topic[3] := ' Regular Color - Veritcal Chat';
Topic[4] := ' Mulit-Colored - Vertical Chat';
Topic[5] := ' Regular Color - One Line Chat';
Topic[6] := ' SysOp Command Menu';
Topic[7] := ' Quit Chat Menu';
TotalPicks := 7;
PicksPerLine := 1; {one column of choices}
Addprefix := 1; {add function key prefixes}
TopleftXY[1] := 0; {system will center menu}
TopleftXY[2] := 3; {Y coordinate}
Boxtype := 5; {fancy box}
If ColorScreen then
begin
Colors[1] := white; {hi forground}
Colors[2] := magenta; {hi background}
Colors[3] := lightgray; {lo foreground}
Colors[4] := blue; {lo background}
Colors[5] := lightgray; {box color}
end
else
begin
Colors[1] := white; {hi forground}
Colors[2] := black; {hi background}
Colors[3] := black; {lo foreground}
Colors[4] := lightgray; {lo background}
Colors[5] := white; {box color}
end;
AllowEsc := false; {inactivate the escape key}
Margins := 5;
end; {with M1 do}
end; {Define_Menu1}
Begin
WriteLn(^R'■ '^A'One Moment'^R' ■');
SplitScreen(25);
Activate_Visible_Screen;
SlideRestoreSCreen(2,Down);
Clrscr;
FillScreen(1,1,80,24,white,blue,chr(176));
Findcursor(X,Y,ScanTop,ScanBot);
OffCursor;
Main_Choice := 1;
Done:=False;
repeat
Which_Chat;
DisplayMenu(M1,false,Main_Choice,Error);
Case Main_Choice of
1 :Begin Oncursor; Chat(False,False); Done:=True; End;
2 :Begin Oncursor; Chat(False,True); Done:=True; End;
3 :Begin OnCursor; RegChat(False); Done:=True; End;
4 :Begin Oncursor; RegChat(True); Done:=TRue; End;
5 :Begin OnCursor; OneLineChat; Done:=True End;
6 :Begin Done:=True; Chat(True,False); Done:=True; End;
7 :Done:=True;
end; {case}
until Done;
OnCursor;
ClrScr;
UnSplit;
Main_Choice:=1;
End;
begin
end.